home *** CD-ROM | disk | FTP | other *** search
/ The PC-SIG Library 10 / The PC-Sig Library - Shareware for the IBM PC and Compatibles (PC-SIG)(Tenth Edition Disks 1-2804)(1991).iso / PC_SIGCD / 20 / 5 / DISK2058.ZIP / UNFAST.EXE / PC.F < prev    next >
Text File  |  1980-01-01  |  7KB  |  366 lines
  1. ;PC - Doucument reporter. (C) PC 16/5/1988
  2. const maxd=1024,blen=512       ;BLEN >= 256
  3. var cd,m,mad,loc,wordstar,ds
  4. var32 topscr,botscr,fseek,secondline,fad,atemp
  5. fbuf ? blen
  6.  
  7. #include fsort.fi
  8.  
  9. on error
  10.     {
  11.     print bios
  12.     error msg "\dos.err"
  13.     print bios "!"
  14.     terminate
  15.     }
  16.  
  17. proc clear_bot
  18.     {
  19.     colour 7
  20.     scroll 0,20,79,24,0
  21.     cursor 20,0
  22.     locate 20,0
  23.     }
  24.  
  25. proc show_ws
  26.     {
  27.     colour 7
  28.     locate 2,70:print " WS ";
  29.     if wordstar=255 then print "OFF "; else print "ON  ";
  30.     }
  31.  
  32. function fill_buffer
  33.     {
  34.     fill blen/2 from fbuf with 1a1ah
  35.     read_len=read #1,blen to fbuf
  36.     return fbuf
  37.     }
  38.  
  39. proc get_eof
  40.     {
  41.     seek #1,eof
  42.     rax=reg ax:rdx=reg dx
  43.     topscr=rax+rdx*65536 ;Current address for TOPSCR.
  44.     }
  45.  
  46. proc backline(clines)
  47.     {
  48.     const backlen=160
  49.     repeat clines
  50.     {
  51.     fad=topscr-backlen
  52.     if (high fad)<0 then topscr=0:return
  53.     seek #1,fad
  54.     fill backlen/2+1 from fbuf with 1a1ah
  55.     read_len=read #1,backlen to fbuf
  56.     m=fbuf
  57.  
  58.     atemp=fad
  59.     next_line13:
  60.     col=0
  61.     back_loop:
  62.     c=peekb m:m++
  63.     if c>31 then
  64.         {
  65.         back_print:
  66.         col++
  67.         if col<80 then goto back_loop
  68.         c=13
  69.         }
  70.     if c=26 then goto next_backline
  71.     if c=13 then
  72.         {
  73.         ad32=m-fbuf
  74.         topscr=atemp
  75.         atemp=fad+ad32
  76.         goto next_line13
  77.         }
  78.     if c<>9 then goto back_print
  79.     col=(col and 248)+8
  80.     goto back_loop
  81.  
  82.     next_backline:
  83.     }
  84.     }
  85.  
  86. proc position(addr)
  87.     {
  88.     px=addr mod 6
  89.     py=addr/6
  90.     locate 3+py,px*13+1
  91.     }
  92.  
  93. proc pos_colour(colc)
  94.     {
  95.     repeat 2 video[locpos+1]b=colc:locpos+=2
  96.     while video[locpos-2]b<>' ' video[locpos+1]b=colc:locpos+=2
  97.     cursor 3+py,px*13+2
  98.     }
  99.  
  100. function get_char
  101.     {
  102.     if m>=(fbuf+blen) then
  103.     {
  104.     m=fill_buffer
  105.     }
  106.     else m++
  107.     return peekb m
  108.     }
  109.  
  110. proc get_files
  111.     {
  112.     xd=ffind
  113.     while peekb    xd print bios chr peekb    xd;:xd++
  114.     print bios " ";
  115. #errors    off
  116.     find first ffind
  117.     goto entry
  118.  
  119.     while cd<maxd
  120.     {
  121.     find next
  122. #errors    on
  123.     entry:
  124.     if error then return
  125.     moveb 13 from dta segment|dta offset+30 to ds|mad
  126.     mad+=13:cd++
  127.     }
  128.     }
  129.  
  130. proc open_file
  131.     {
  132.     moveb 13 from ds|loc*13 to fbuf
  133.     open #1,fbuf
  134.     clear_bot
  135.     colour 70h:locate 2,2
  136.     pm=fbuf
  137.     while peekb pm print chr peekb pm;:pm++
  138.     show_ws
  139.     }
  140.  
  141. proc display_file
  142.     {
  143.     open_file
  144.     topscr=0
  145.  
  146.     forever
  147.     {
  148.     seek #1,topscr
  149.     eof_flag=0:pagelen=0
  150.     m=fbuf+blen
  151.     for y=3 to 18
  152.     ad32=m-fbuf
  153.     if y=4 then secondline=topscr+ad32
  154.  
  155.     locate y,0
  156.     col=0
  157.     loop_prt:
  158.     if m>=(fbuf+blen) then m=fill_buffer
  159.     c=peekb m:m++:pagelen++
  160.     if c>31 then
  161.         {
  162.         print_char:
  163.         col++:print chr c and wordstar;
  164.         if col<80 then goto loop_prt
  165.         c=13 ; Start new line.
  166.         }
  167.     if c=26 then print "<EOF>";:eof_flag=1:goto fill_end
  168.     if c=13 then
  169.         {
  170.         if col<80 then fill (80-col) from video|locpos with 0720h
  171.         goto next_line
  172.         }
  173.     if c=10 then goto loop_prt ; Skip printing this character.
  174.     if c<>9 then goto print_char
  175.     ncol=(col and 248)+8
  176.     repeat ncol-col print " ";
  177.     col=ncol
  178.     goto loop_prt
  179.  
  180.     next_line:
  181.     next y
  182.  
  183.     fill_end:
  184.     fl=19*160-locpos
  185.     if fl>0 then fill fl/2 from video|locpos with 0720h
  186.  
  187.     botscr=topscr+pagelen
  188.     wait_eof:
  189.     wait for keypressed
  190.     s=scan
  191.  
  192.     if s=45 then goto abort ; X to abort.
  193.     if s=1 then goto finish_display
  194.     if s=17 then
  195.         {
  196.         wordstar=wordstar xor 128
  197.         show_ws
  198.         goto next_display
  199.         }
  200.  
  201.     if s=71 then topscr=0:goto next_display
  202.     if s=72 then backline(1):goto next_display
  203.     if s=73 then backline(16):goto next_display
  204.  
  205.     if eof_flag then goto wait_eof
  206.  
  207.     if s=79 then get_eof:backline(15):goto next_display
  208.     if s=80 then topscr=secondline:goto next_display
  209.     ;if s=81 then do nothing, default is view next page.
  210.  
  211.     topscr=botscr
  212.     next_display:
  213.     }
  214.  
  215.     finish_display:
  216.     close #1
  217.     }
  218.  
  219. proc print_file
  220.     {
  221.     open_file
  222.     cursor 20,0:print bios "Press ESC to abort printing. "
  223.     m=fbuf+blen
  224.  
  225.     print_line:
  226.     col=0
  227.     print_loop:
  228.     if m>=(fbuf+blen) then m=fill_buffer
  229.     c=peekb m:m++
  230.     if c>31 then
  231.     {
  232.     lprint_char:
  233.     col++:lprint chr c and wordstar;
  234.     goto print_loop
  235.     }
  236.     if c=26 then lprint ff;:goto print_end
  237.     if c=13 then
  238.     {
  239.     lprint
  240.     if key=27 then goto print_end
  241.     goto print_line
  242.     }
  243.     if c=10 then goto print_loop ; Skip printing this character.
  244.     if c<>9 then goto lprint_char
  245.     ncol=(col and 248)+8
  246.     repeat ncol-col lprint " ";
  247.     col=ncol
  248.     goto print_loop
  249.  
  250.     print_end:
  251.     close #1
  252.     }
  253.  
  254. proc ddir(mad)
  255.     {
  256.     mad*=13
  257.     mn=0
  258.  
  259.     while (mn<96) and ((mad/13)<cd)
  260.     {
  261.     position(mn)
  262.     locpos+=2
  263.     a=mad
  264.     print chr ucase ds[a]b;
  265.     a++:l=12
  266.     while ds[a]b print chr lcase ds[a]b;:a++:l--
  267.     mad+=13
  268.     mn++
  269.     while l print " ";:l--
  270.     }
  271.     while mn<96 position(mn):mn++:print "             ";
  272.     }
  273.  
  274.  
  275. wordstar=255
  276. ds=allocate (maxd*13)/16+15
  277.  
  278. mad=0
  279. cd=0
  280. print bios "Reading files... ";
  281. #errors    off
  282. open #1,"\PC.FIL":if error then    get_files:goto start_display
  283. #errors    on
  284.  
  285. m=fbuf+blen
  286. loopf:
  287. c=get_char
  288. loopf2:
  289. if c=26 then goto start_display
  290. if c<=' ' then goto loopf
  291. a=ffind
  292. while c>' '
  293.     {
  294.     pokeb a,ucase c
  295.     a++
  296.     if a>=str_end then error 13
  297.     c=get_char
  298.     }
  299.  
  300. gf_execute:
  301. pokeb a,0
  302. get_files
  303. if cd<maxd then goto loopf2
  304.  
  305. start_display:
  306. close #1
  307. drawloc=0:loc=0
  308.  
  309. if not cd then error 18
  310. if not sort(ds,0,13,cd)    then error 1
  311.  
  312. display:
  313. cls
  314. colour 71h:locate 0,7
  315. print " PC - Document reporter. Written by Peter Campbell, version 1.2 "
  316. colour 6:locate 1,0
  317. print " Use ARROWS to select file, ENTER to display file on screen or P to print file."
  318. colour 7
  319. repeat 80 print chr 196;
  320. locate 19,0
  321. repeat 80 print chr 196;
  322. show_ws
  323. colour 7
  324. locate 19,2:print " ";cd;" Files. ";
  325. goto redis2
  326.  
  327. redis:
  328. drawloc=(loc/6)*6
  329. redis2:
  330. ddir(drawloc)
  331.  
  332. forever
  333.     {
  334.     clear_bot
  335.     position(loc-drawloc)
  336.     pos_colour(70h)
  337.     wait for keypressed
  338.     ks=keyscan:s=high ks:k=lcase low ks
  339.  
  340.     position(loc-drawloc)
  341.     pos_colour(7)
  342.     if k=27 then goto abort
  343.     if k='p' then print_file:goto display
  344.     if k=13 then display_file:goto display
  345.     loc-=s=75
  346.     loc+=s=77
  347.     if s=72 then loc-=6
  348.     if s=80 then loc+=6
  349.     if s=71 then loc=0
  350.     if s=79 then loc=cd-1
  351.     if s=73 then loc-=96
  352.     if s=81 then loc+=96
  353.     if loc<0 then loc=0
  354.     if loc>cd-1 then loc=cd-1
  355.     if (loc<drawloc) or (loc>(drawloc+95)) then goto redis
  356.     }
  357.  
  358. abort:
  359. clear_bot
  360. terminate
  361.  
  362. ffind:
  363. fname '*.DOC'
  364. space 27    ;Total length=32
  365. str_end:
  366.